home *** CD-ROM | disk | FTP | other *** search
/ Amiga Collections: Topik / Topik - Disk 37 - Games 3 (19xx)(Topik Public Domain)(PD)[WB].zip / Topik - Disk 37 - Games 3 (19xx)(Topik Public Domain)(PD)[WB].adf / GRIBIT / Gribit.BAS.pp / Gribit.BAS
BASIC Source File  |  1991-02-24  |  19KB  |  1,175 lines
  1. REM $OPTION Y+,k150
  2. '
  3. ' Gribit by Alan Mead
  4. '
  5. ' Copyright © 1990 Amiga Computing
  6. '
  7. Gribit:
  8. SCREEN 2,320,200,4,1
  9.                              
  10. WINDOW 2,"GRIBIT, © 1990 Amiga Computing ",(0,0)-(311,185),16+128,2
  11. DEFINT a-z
  12. DEFLNG s,h
  13. buffs = 198
  14. buffc = 134
  15. hiscore=0
  16. life=3
  17. FOR cl=1 TO 4
  18.  MENU cl,0,0,""
  19. NEXT 
  20. i$ = ".info"
  21. vol = 127
  22. DIM temp%(66)
  23. DIM anim%(14,66)
  24. DIM y%(9)
  25. DIM x%(17)
  26. DIM array%(17,10)
  27. DIM ctemp%(30)   
  28. DIM cur%(15,30)
  29.  
  30. DIM cy%(15)
  31. DIM cx%(15)
  32.                                       
  33. d=0
  34. FOR y=23 TO 143 STEP 8
  35.  cy%(d)=y
  36.  d=d+1
  37. NEXT
  38.  
  39. d=0
  40. FOR x=126 TO 246 STEP 8
  41.  cx%(d)=x
  42.  d=d+1
  43. NEXT
  44.  
  45.  
  46. FOR y=0 TO 9
  47.  y%(y)=(y*17)+17
  48. NEXT
  49.  
  50.  
  51. FOR x=0 TO 17
  52.  x%(x)=x*17
  53. NEXT
  54.  
  55. GOSUB cols
  56.  
  57. GOSUB aload
  58.  
  59. ob=7
  60.  
  61. options:
  62. REM $EVENT OFF
  63. GOSUB nopoint
  64. score = 0
  65. scrn = 0
  66. WINDOW CLOSE 3
  67. WINDOW 2
  68.  
  69. FOR cl=1 TO 4
  70.  MENU cl,0,0,""
  71. NEXT
  72.  
  73. op2:
  74. CLS
  75. n$="t1":GOSUB fetch
  76. LOCATE 1,12
  77. PRINT  "OPTIONS"
  78. LOCATE 6,7
  79. PRINT  "Press key"
  80. LOCATE 8,7
  81. PRINT "G to play Game"
  82. LOCATE 10,7
  83. PRINT "S to edit Screens"
  84. LOCATE 12,7
  85. PRINT "C to edit Characters"
  86. LOCATE 14,7
  87. PRINT "I for Instructions"
  88. LOCATE 16,7
  89. PRINT "Q to Quit"
  90. kloop:
  91. a$=INKEY$
  92. a$=UCASE$(a$)
  93. IF a$="G" THEN GOTO game
  94. IF a$="S" THEN GOTO screened
  95. IF a$="C" THEN GOTO spriteed
  96. IF a$="I" THEN GOTO ins
  97. IF a$="Q" THEN CLS:GOSUB apoint:MENU RESET:WINDOW CLOSE 2:END 
  98. GOTO kloop
  99.  
  100. ins:
  101. CLS
  102. n$="border":GOSUB fetch
  103. LOCATE 1,10
  104. PRINT "INSTRUCTIONS"
  105. LOCATE 6,5
  106. PRINT "Controls"
  107. LOCATE 7,5
  108. PRINT "Mouse 1 for Editors"
  109. LOCATE 8,5
  110. PRINT "Joy 2 for game"
  111. LOCATE 10,5
  112. PRINT "Collect all Mushrooms"
  113. LOCATE 11,5
  114. PRINT "to complete screens "
  115. LOCATE 13,5
  116. PRINT "Fire to blow bubbles"
  117. LOCATE 15,5
  118. PRINT "Keys open doors"
  119. LOCATE 18,5
  120. PRINT "Spacebar to continue"
  121. wm:
  122. a$ = INKEY$
  123. IF a$ <>" " THEN GOTO wm
  124. GOTO op2
  125.  
  126. screened:
  127. REM $EVENT ON
  128. GOSUB apoint
  129. IF ob >7 THEN ob =7
  130.  
  131. GOSUB wipe
  132.  
  133. MENU 1,0,1,"Project     "
  134. MENU 1,1,1,"Clear Screen"
  135. MENU 1,2,1,"Options "
  136.  
  137. MENU 2,0,1," Load "
  138. mn = 2:GOSUB menset
  139.  
  140. MENU 3,0,1," Save "
  141. mn = 3:GOSUB menset
  142.  
  143. ON MENU GOSUB choice
  144. MENU ON
  145.  
  146. x=0:y=0:x1=0:y1=0:f=10:frog=0
  147.  
  148. dslop:
  149. m=MOUSE(0)
  150. IF m<>0 THEN GOTO dslop
  151.  
  152. move:
  153. a$ = INKEY$
  154. w=MOUSE(0)
  155. x=INT(MOUSE(1)/17)
  156. y=INT(MOUSE(2)/17)-1
  157. IF y < 0 THEN y=0:GOSUB supdate 
  158. IF x < 0 THEN x = 0
  159. IF x > 17 THEN x = 17
  160. IF y > 9 THEN y = 9
  161. IF (w <> 0) OR (a$=" ") THEN      
  162.       IF y=0 THEN GOTO move
  163.       IF x=0 THEN GOTO move
  164.       IF y=9 THEN GOTO move
  165.       IF x=17 THEN GOTO move           
  166.    IF x%(x)=frogx THEN
  167.       IF y%(y)=frogy THEN frog=0
  168.    END IF   
  169.    IF ob = 8 THEN                  
  170.       IF frog = 1 THEN GOSUB warn          
  171.       IF frog = 0 THEN
  172.            fob=array%(x,y)
  173.            PUT (x%(x),y%(y)),anim%(ob,0),PSET:frog =1
  174.            frogx =x%(x):frogy =y%(y)
  175.            array%(x,y)=ob
  176.       END IF
  177.     END IF      
  178.    IF ob <> 8 THEN  
  179.          array%(x,y)=ob
  180.          PUT (x%(x),y%(y)),anim%(ob,0),PSET  
  181.    END IF 
  182.         
  183. END IF   
  184. GOTO move
  185.  
  186. supdate:
  187. w = MOUSE(0)
  188. IF (w <>0) OR (a$ = " ") THEN
  189. obx=INT(MOUSE(1)/20)
  190. IF obx <0 THEN RETURN
  191. IF obx >8 THEN RETURN
  192. ob=obx
  193. END IF
  194. PUT (x%(17),y%(0)-17),anim%(ob,0),PSET
  195. RETURN
  196.  
  197. warn:
  198. WINDOW 3,"Warning",(0,0)-(311,24),8+128,2
  199. LOCATE 2,1
  200. PRINT "One Frog completes each screen."
  201. winch:
  202. win=WINDOW(7)
  203. IF win <>0 then GOTO winch
  204. WINDOW OUTPUT 2
  205. RETURN
  206.  
  207. menset:
  208. s$="Screen "
  209. FOR men = 1 TO 18
  210.  sn$=CHR$(64+men)
  211.  sc$=s$+sn$
  212.  MENU mn,men,1,sc$
  213. NEXT
  214. RETURN
  215.  
  216. choice:
  217. id=MENU(0)
  218. IF id = 2 THEN GOTO m2
  219. IF id = 3 THEN GOTO m3
  220. IF MENU(1)=1 THEN GOSUB wipe:RETURN  
  221. IF MENU(1)=2 THEN MENU STOP:GOTO options
  222.  
  223. m2:
  224. scc=(MENU(1)+9)
  225. x$=STR$(scc)
  226. n$=RIGHT$(x$,2) 
  227. GOSUB fetch
  228. LOCATE 1,21
  229. PRINT "Screen ";CHR$(scc+55);
  230. RETURN
  231.  
  232. m3:
  233. scc=(MENU(1)+9)
  234. x$=STR$(scc)
  235. n$=RIGHT$(x$,2)
  236. GOSUB store
  237. LOCATE 1,21
  238. PRINT "Screen ";CHR$(scc+55);
  239. RETURN
  240.  
  241. wipe:
  242. frog=0
  243. CLS
  244. n$="border"
  245. GOSUB fetch
  246. LOCATE 1,21
  247. PRINT "Screen     ";
  248.  
  249. pob:
  250. FOR pz = 0 TO 8
  251.  PUT (x%(pz)+(pz*3),y%(0)-17),anim%(pz,0),PSET
  252. NEXT
  253. PUT (x%(17),y%(0)-17),anim%(ob,0),PSET
  254. RETURN
  255.  
  256. store:
  257. IF frog=0 THEN
  258. GOSUB warn
  259. RETURN
  260. END IF
  261. GOSUB black
  262. OPEN n$ FOR OUTPUT AS 1 LEN=buffs
  263. FOR dx=0 TO 17
  264.  FOR dy=0 TO 9
  265.   d=array%(dx,dy)
  266.   PRINT #1,MKI$ (d);
  267.  NEXT 
  268. NEXT
  269. CLOSE 1
  270. d$ = n$+i$
  271. KILL d$
  272. GOSUB cols
  273. RETURN
  274.  
  275. fetch:
  276. GOSUB black
  277. dime = 0 
  278. OPEN n$ FOR INPUT AS 1 LEN=buffs
  279. FOR dx=0 TO 17
  280.  FOR dy=0 TO 9
  281.   array%(dx,dy)=CVI(INPUT$(2,1))
  282.    IF array%(dx,dy)=8 THEN
  283.     frogx=x%(dx)
  284.     frogy=y%(dy)
  285.     x=dx
  286.     y=dy
  287.     frog=1
  288.    END IF
  289.   IF array%(dx,dy)=2 THEN dime = dime +1
  290.  NEXT
  291. NEXT
  292. CLOSE 1
  293. GOSUB refresh
  294. GOSUB cols
  295. RETURN
  296.  
  297. refresh:
  298. FOR dx=1 TO 16  
  299.  d=array%(dx,0)
  300.  PUT (x%(dx),y%(0)),anim%(d,0),PSET
  301. NEXT
  302. FOR dy=0 TO 9 STEP 1  
  303.  d=array%(17,dy)
  304.  PUT (x%(17),y%(dy)),anim%(d,0),PSET
  305. NEXT
  306. FOR dx=16 TO 1 STEP -1 
  307.  d=array%(dx,0)
  308.  PUT (x%(dx),y%(9)),anim%(d,0),PSET
  309. NEXT
  310. FOR dy=9 TO 0 STEP -1  
  311.  d=array%(0,dy)
  312.  PUT (x%(0),y%(dy)),anim%(d,0),PSET
  313. NEXT
  314. dy=8
  315. rloop: 
  316. FOR dx=1 TO 16  
  317.  d=array%(dx,dy)
  318.  PUT (x%(dx),y%(dy)),anim%(d,0),PSET
  319. NEXT
  320. dy=dy-1
  321. FOR dx=16 TO 1 STEP -1  
  322.  d=array%(dx,dy)
  323.  PUT (x%(dx),y%(dy)),anim%(d,0),PSET
  324. NEXT
  325. dy=dy-1
  326. IF dy = 0 THEN RETURN
  327. GOTO rloop
  328.  
  329. ok:
  330. FOR d= 1 TO 10
  331.  SOUND d*50,1,vol,1
  332.  for del = 1 to 1000:NEXT
  333. NEXT
  334. RETURN
  335.  
  336. aload:
  337. LOCATE 2,2
  338. PRINT "Loading Sprites"
  339. s1$="sp"
  340. FOR i = 1 to 14
  341.  si$=STR$(i)
  342.  ls=LEN(si$)-1
  343.  s2$=RIGHT$(si$,ls)
  344.  n$=s1$+s2$
  345.  n=i-1
  346.  GOSUB nload
  347. NEXT
  348. LOCATE 2,2
  349. PRINT "               "
  350. RETURN
  351.  
  352. nload:
  353. OPEN n$ FOR INPUT AS 1 LEN=buffc
  354. FOR d=0 TO 66
  355. anim%(n,d)=CVI(INPUT$(2,1))
  356. NEXT d
  357. CLOSE 1
  358. RETURN
  359.  
  360. black:
  361. FOR col = 2 TO 15
  362.  PALETTE col,0,0,0
  363. NEXT
  364. RETURN
  365.  
  366. cols:
  367. PALETTE 0,0,0,0       :REM black
  368. PALETTE 1,1,.5,0      :REM brown
  369. PALETTE 2,0,1,0       :REM green
  370. PALETTE 3,1,.73,0     :REM yellow
  371. PALETTE 4,1,1,.13     :REM yellow
  372. PALETTE 5,1,.13,.93   :REM violet
  373. PALETTE 6,.8,0,.9     :REM purple
  374. PALETTE 7,.25,.25,1   :REM blue
  375. PALETTE 8,.2,.2,.75   :REM blue
  376. PALETTE 9,.15,.15,.5  :REM blue
  377. PALETTE 10,1,0,0      :REM red
  378. PALETTE 11,.6,0,0     :REM red
  379. PALETTE 12,.4,0,0     :REM red
  380. PALETTE 13,.4,.4,.4   :REM white
  381. PALETTE 14,.6,.6,.6   :REM white
  382. PALETTE 15,1,1,1      :REM white
  383. GOSUB ok
  384. RETURN
  385.  
  386. spriteed:
  387. REM $EVENT ON 
  388. GOSUB apoint
  389.  
  390. GOSUB black
  391.  
  392. c=7:e=1:s=0:del=500:sy=0:sx=0:y1=95:x1=18
  393. sh0=0:mx=126:mxt=mx:fl=1
  394.  
  395. GOSUB curser
  396.  
  397. CLS
  398.  
  399. GOSUB grid
  400.  
  401. c=1:i=2
  402.  
  403. FOR y=31 TO 135 STEP 8
  404.  PUT (270,y),cur%(i,0),PSET
  405.  i=i+1
  406. NEXT y
  407.  
  408. i=6
  409.  
  410. PUT (270,151),cur%(i,0),PSET
  411.  
  412. x=126:y=23:yn=115:xn=18:sh0=4
  413.  
  414. MENU 1,0,1,"Project "
  415. MENU 1,1,1,"Restore "
  416. MENU 1,2,1,"Save All"
  417. MENU 1,3,1,"Options"
  418.  
  419. MENU 2,0,1,"Change"  
  420. MENU 2,1,1,"Fill  "
  421. MENU 2,2,1,"Erase "
  422. MENU 2,3,1,"X Flip"
  423. MENU 2,4,1,"Y Flip"
  424. MENU 2,5,1,"Rotate"
  425.  
  426. MENU 3,0,1,"Scroll"
  427. MENU 3,1,1,"Up    "
  428. MENU 3,2,1,"Down  "
  429. MENU 3,3,1,"Left  "
  430. MENU 3,4,1,"Right "
  431.  
  432. MENU 4,0,1,"Copy"
  433. MENU 4,1,1,"Copy To"
  434.  
  435. ON MENU GOSUB cselect
  436. MENU ON
  437.  
  438. GOSUB place
  439.  
  440. GOSUB cols
  441.  
  442. ob = 0
  443.  
  444. nob = ob:cb = 1:GOSUB obox
  445.  
  446. GOSUB update
  447.  
  448. mslop:
  449. m=MOUSE(0)
  450. IF m<>0 THEN GOTO mslop
  451.  
  452. cmove:
  453. a$=INKEY$
  454. m=MOUSE(0)
  455. xm=MOUSE(1)-7
  456. ym=MOUSE(2)-7
  457. IF (ym+7) > y%(9) THEN GOSUB gupdate
  458. IF xm>260 THEN GOSUB colour
  459. L=0
  460. IF xm<121 THEN xm=121:L=1
  461. IF xm>247 THEN xm=247:L=1
  462. IF ym<16 THEN ym=16:L=1
  463. IF ym>143 THEN ym=143:L=1
  464. IF L=1 THEN GOTO cmove
  465. xd=INT(xm/8)
  466. yd=INT(ym/8)
  467. x=cx%(xd-15)
  468. y=cy%(yd-2)
  469. px=(x%(ob)+(xd+4)+(ob*3)-16):py=(y%(9)+(yd-2))
  470. IF (m <> 0) OR (a$=" ") THEN GOSUB set
  471. GOTO cmove
  472.  
  473. set:
  474. PSET (px,py),i
  475. PSET (50+xd,50+yd),i
  476. PUT (x,y),cur%(i,0),PSET
  477. RETURN
  478.  
  479. colour:
  480. IF MOUSE(1)>279 THEN RETURN
  481. IF ( m <> 0 ) OR ( a$ = " " ) THEN i=POINT(MOUSE(1)-2,MOUSE(2))
  482. IF i<0 THEN RETURN
  483. IF i>15 THEN RETURN
  484. PUT (270,151),cur%(i,0),PSET
  485. RETURN
  486.  
  487. gupdate:
  488. olob = ob
  489. IF ( m = 1 ) OR ( a$ = " " ) THEN
  490. ob = INT(MOUSE(1)/20)
  491. IF ob <0 THEN ob = olob:RETURN
  492. IF ob >13 THEN ob = olob:RETURN
  493. nob = olob:cb = 0:GOSUB obox
  494. nob = ob:cb = 1:GOSUB obox
  495. GOSUB update
  496. END IF
  497. RETURN
  498.  
  499. ccopy:
  500. GOSUB tpoint
  501. copl:
  502. a$=INKEY$
  503. mc=MOUSE(0)
  504. cxm=MOUSE(1)-7
  505. cym=MOUSE(2)-7
  506. IF ( mc = 1 ) OR ( a$ = " " ) THEN GOTO copy
  507. GOTO ccopy
  508.  
  509. copy:
  510. olob = ob
  511. IF (cym+7) > y%(9) THEN  
  512.    ob = INT(MOUSE(1)/20)
  513.    IF ob <0 THEN ob = olob:GOTO apoint
  514.    IF ob >13 THEN ob = olob:GOTO apoint
  515.    GOSUB downdate
  516. END IF
  517. GOTO apoint
  518.  
  519. downdate:
  520. nob = olob:cb = 0:GOSUB obox
  521. nob = ob:cb = 1:GOSUB obox
  522. GET (65,52)-(80,67),anim%(ob,0)
  523. PUT (x%(ob)+(ob*3)+3,y%(9)),anim%(ob,0),PSET
  524. GOSUB ok
  525. RETURN
  526.  
  527. obox:
  528. tx = x%(nob)+(nob*3)+1
  529. ty = y%(9)-2 
  530. bx = tx + 19
  531. by = ty + 19
  532. LINE (tx,ty)-(bx,by),cb,b
  533. RETURN
  534.  
  535. lay:
  536. FOR n=0 TO 13
  537.  GET (x%(n)+(n*3)+3,y%(9))-(x%(n)+(n*3)+18,y%(9)+15),anim%(n,0)
  538. NEXT
  539. RETURN
  540.  
  541. place:
  542. FOR pz = 0 TO 13
  543.  PUT (x%(pz)+(pz*3)+3,y%(9)),anim%(pz,0),PSET
  544. NEXT
  545. RETURN
  546.  
  547. cselect:
  548. me=MENU(0)
  549. IF me=2 THEN GOTO two           
  550. IF me=3 THEN GOTO three
  551. IF me=4 THEN GOTO four
  552. IF MENU(1)=1 THEN GOTO creset
  553. IF MENU(1)=2 THEN GOTO csave
  554. IF MENU(1)=3 THEN GOSUB lay:GOTO options
  555. IF MENU(1)=4 THEN CLS:MENU RESET:END 
  556.  
  557. two:
  558. IF MENU(1)=1 THEN GOTO fill
  559. IF MENU(1)=2 THEN GOTO empty
  560. IF MENU(1)=3 THEN s=2:GOTO crefresh:REM xflip
  561. IF MENU(1)=4 THEN s=3:GOTO crefresh:REM yflip
  562. IF MENU(1)=5 THEN s=4:GOTO crefresh:REM rotate
  563.  
  564. three:
  565. IF MENU(1)=1 THEN s=1:sy=+1:GOTO crefresh:REM scroll up
  566. IF MENU(1)=2 THEN s=1:sy=-1:GOTO crefresh:REM scroll down
  567. IF MENU(1)=3 THEN s=1:sx=+1:GOTO crefresh:REM scroll left
  568. IF MENU(1)=4 THEN s=1:sx=-1:GOTO crefresh:REM scroll right
  569.  
  570. four:
  571. IF MENU(1)=1 THEN GOTO ccopy
  572.  
  573. update:
  574. GET (x%(ob)+(ob*3)+3,y%(9))-(x%(ob)+(ob*3)+18,y%(9)+15),temp%
  575. PUT (65,52),temp%,PSET
  576. s=1
  577. GOSUB crefresh
  578. RETURN
  579.  
  580. swop:
  581. GET (65,52)-(80,67),temp%
  582. PUT (x%(ob)+(ob*3)+3,y%(9)),temp%,PSET
  583. RETURN   
  584.  
  585. fill:
  586. FOR y=23 TO 143 STEP 8
  587. FOR x=126 TO 246 STEP 8
  588. px=(50+INT(x/8)):py=(50+INT(y/8))
  589. PSET (px,py),i
  590. PUT (x,y),cur%(i,0),PSET
  591. NEXT x,y
  592. GOSUB swop
  593. GOSUB ok
  594. RETURN
  595.  
  596. empty:
  597. FOR y=23 TO 143 STEP 8
  598.  FOR x=126 TO 246 STEP 8
  599.   px=(50+INT(x/8)):py=(50+INT(y/8))
  600.   PSET (px,py),0
  601.   PUT (x,y),cur%(0,0),PSET
  602.  NEXT
  603. NEXT
  604. GOSUB swop
  605. GOSUB ok
  606. RETURN
  607.  
  608. grid:
  609. FOR x=0 TO 128 STEP 8
  610.  LINE(125,22+x)-(253,22+x),e
  611.  LINE(125+x,22)-(125+x,150),e
  612. NEXT
  613. RETURN
  614.  
  615. curser:
  616. FOR ci=0 TO 15
  617.  LINE (0,0)-(6,6),ci,bf  
  618.  GET (0,0)-(6,6),cur% (ci,0)
  619. NEXT                  
  620. RETURN
  621.  
  622. csave:
  623. s1$="sp"
  624. FOR i = 1 TO 14
  625.  si$=STR$(i)
  626.  ls=LEN(si$)-1
  627.  s2$=RIGHT$(si$,ls)
  628.  n$=s1$+s2$
  629.  n=i-1
  630.  GOSUB cstore
  631. NEXT
  632. LOCATE 2,2
  633. PRINT "                                 " 
  634. GOSUB ok      
  635. RETURN
  636.                                      
  637. cstore:
  638. GET (x%(n)+(n*3)+3,y%(9))-(x%(n)+(n*3)+18,y%(9)+15),temp%
  639. LOCATE 2,2
  640. PRINT "Saving Sprite";n;
  641. OPEN n$ FOR OUTPUT AS 1 LEN=buffc
  642. FOR d=0 TO 66
  643.  PRINT #1,MKI$(temp%(d));
  644. NEXT
  645. CLOSE 1
  646. d$ = n$+i$
  647. KILL d$
  648. RETURN
  649.  
  650. crefresh:
  651. it=i
  652. FOR y=23 TO 143 STEP 8
  653.  FOR x=126 TO 246 STEP 8
  654.   px=(50+INT(x/8)):py=(50+INT(y/8))
  655.   i=POINT (px+sx,py+sy)
  656.   IF s=1 THEN PUT (x,y),cur%(i,0),PSET
  657.   IF s=2 THEN PUT (372-x,y),cur%(i,0),PSET
  658.   IF s=3 THEN PUT (x,166-y),cur%(i,0),PSET
  659.   IF s=4 THEN PUT (103+y,269-x),cur%(i,0),PSET
  660.  NEXT
  661. NEXT 
  662. GET (x,y)-(x+6,y+6),ctemp%
  663. z=x:q=y
  664. IF s >1 THEN GOSUB drawsprite
  665. IF sx <> 0 THEN GOSUB drawsprite
  666. IF sy <> 0 THEN GOSUB drawsprite
  667. sx=0:sy=0
  668. i=it
  669. GOSUB ok
  670. RETURN
  671.  
  672. drawsprite:
  673. FOR y=23 TO 143 STEP 8
  674.  FOR x=126 TO 246 STEP 8
  675.   i=POINT (x,y)
  676.   px=(50+INT(x/8)):py=(50+INT(y/8))
  677.   PSET(px,py),i
  678.  NEXT  
  679. NEXT
  680. GOSUB swop
  681. RETURN
  682.  
  683. creset:
  684. GOSUB aload
  685. FOR pz = 0 TO 13
  686.  PUT (x%(pz)+(pz*3)+3,y%(9)),anim%(pz,0),PSET
  687. NEXT
  688. PUT (65,52),anim%(ob,0),PSET
  689. GOSUB update
  690. RETURN
  691.  
  692. game:
  693. gf=12
  694. scrn=0:life = 3:kgot = 2:kp = 13:ip = 4:e = 90
  695. score = -10
  696. PUT (0,0),anim%(9,0),PSET
  697. PUT (0,0),anim%(3,0),OR
  698. GET (0,0)-(15,15),anim%(14,0)
  699. game2:
  700. CLS
  701. gst =0
  702. gd=0
  703. scrn = scrn +1
  704. score = score + scrn * 10
  705. IF scrn >18 THEN scrn =1 
  706. scno = scrn+9
  707. IF score >10 THEN
  708. LOCATE 1,5
  709. PRINT "Screen ";CHR$(scrn + 64);"   Score";score;
  710. END IF
  711. scc=scno
  712. x$=STR$(scc)
  713. n$=RIGHT$(x$,2)
  714. dime = 0 
  715. OPEN n$ FOR INPUT AS 1 LEN=buffs
  716. FOR dx=0 TO 17
  717.  FOR dy=0 TO 9
  718.   array%(dx,dy)=CVI(INPUT$(2,1))
  719.   IF array%(dx,dy)=8 THEN
  720.    frogx=x%(dx)
  721.    frogy=y%(dy)
  722.    x=dx
  723.    y=dy
  724.    frog=1
  725.   END IF
  726.   IF array%(dx,dy)=2 THEN dime = dime +1
  727.  NEXT
  728. NEXT
  729. CLOSE 1
  730. IF score >10 THEN
  731.  WINDOW CLOSE 3
  732.  WINDOW 2
  733. END IF
  734. GOSUB refresh
  735.  
  736. f=10:x1=x:y1=y:xg1=x:yg1=y:xg=x:yg=y:gst=0
  737. gdl=10:gc=0:ibx=8:bori=0
  738. LOCATE 1,2
  739. PRINT "                                              "
  740. GOSUB trow
  741. GOSUB lives
  742. GOSUB ice
  743. GOSUB keys
  744. GOSUB energy
  745. GOSUB ok
  746.  
  747. gmove:
  748. a$=INKEY$
  749. a$ = UCASE$(a$)
  750. w=STRIG(3)
  751. x=x+STICK(2)
  752. y=y+STICK(3)
  753. IF x < 0 THEN x = 0
  754. IF x > 17 THEN x = 17
  755. IF y < 0 THEN y = 0
  756. IF y > 9 THEN y = 9
  757. zob=array%(x,y)
  758. IF zob =9 THEN GOSUB iceg
  759. IF zob =7 THEN x=x1:y=y1:cq=0
  760. IF zob =20 THEN e = e-10:GOSUB energy
  761.  
  762. IF zob =4 THEN
  763.  SOUND 164.81,1,vol,0
  764.  
  765. IF kgot =0 THEN
  766.    FOR d = 1 TO 10000:NEXT
  767.    x=x1:y=y1
  768.    GOTO gm2
  769. END IF
  770.  
  771.   kgot = kgot-1
  772.   IF kgot <0 THEN kgot =0
  773.   PUT (x%(kp+kgot+1),0),anim%(0,0),PSET
  774. END IF
  775.  
  776. gm2:
  777. IF a$=  "P" THEN GOSUB pause
  778. IF a$ = CHR$(27) THEN GOTO options
  779. IF a$ = "~" THEN GOTO game2
  780. IF zob = 1 THEN GOSUB plus
  781. IF zob = 2 THEN 
  782.    dime=dime-1
  783.    
  784.    SOUND 523.25,1,vol,0
  785.    FOR d = 1 TO 1000:next
  786.    score = score +10
  787. END IF
  788.  
  789. IF dime <1 THEN goto game2
  790.  
  791. IF zob = 5 THEN GOSUB plus
  792.  
  793. IF zob = 6 THEN  
  794.   SOUND 1760,1,40,0
  795.   SOUND 880,1,40,1
  796.  FOR d = 1 TO 1000:NEXT
  797. END IF
  798.  
  799. IF zob = 20 THEN GOSUB plus 
  800.  
  801. ct=ct+1
  802. IF ct >3 THEN
  803.    ct=0
  804.    IF f=10 THEN f=11:GOTO ctj
  805.    IF f=11 THEN f=10   
  806. END IF 
  807.  
  808. ctj:              
  809. IF zob = 14 THEN 
  810. SOUND 1000,1,vol,0
  811. kgot = kgot +1
  812. IF kgot >4 THEN kgot = 4
  813. PUT (x%(kp+kgot),0),anim%(3,0),PSET
  814. END IF 
  815.  
  816. cq=0
  817. IF x<>x1 THEN cq=cq+1
  818. IF y<>y1 THEN cq=cq+1
  819. IF cq >0 THEN  
  820.     IF w = -1 THEN GOSUB icel
  821.     PUT (x%(x),y%(y)),anim%(f,0),PSET:' * put frog 
  822.     array%(x,y)=15
  823.     blc = array%(x1,y1)
  824.     IF (blc=15) OR (blc=8) OR (blc=9) then
  825.       PUT (x%(x1),y%(y1)),anim%(bori,0),PSET:' * put blank  
  826.       array%(x1,y1)=bori       
  827.     END IF
  828.     bori = 0
  829. END IF
  830.  
  831. IF cq = 0 THEN
  832.  PUT (x%(x),y%(y)),anim%(f,0),PSET:' * put frog 
  833.  array%(x,y)=15
  834. END IF
  835.  
  836. IF dime <1 THEN goto game2
  837.  
  838.  
  839. IF gst =1 THEN
  840.               GOSUB gho
  841. IF x=xg THEN
  842.     IF y=yg THEN GOSUB minus
  843. END IF
  844. END IF
  845. IF life <0 THEN GOTO Over
  846. x1=x:y1=y
  847. gx=INT(RND*17)
  848. gy=INT(RND*9)
  849. pu%=array%(gx,gy)
  850.  
  851. IF pu% = 0 THEN GOSUB sob
  852.  
  853. FOR acx = 1 TO 16
  854.  FOR acy = 1 TO 8
  855.   fall = array%(acx,acy)
  856.  
  857.   IF (fall=1) OR (fall=2) OR (fall=5) OR (fall=14) THEN
  858.  
  859.  
  860.   fto = array%(acx,acy+1)
  861.   IF fto = 0 THEN
  862.    array%(acx,acy)=0
  863.    array%(acx,acy+1)=fall
  864.    PUT (x%(acx),y%(acy+1)),anim%(fall,0),PSET
  865.    PUT (x%(acx),y%(acy)),anim%(0,0),PSET
  866.  
  867.    hb=array%(acx,acy+2)
  868.    IF hb=15 THEN GOSUB bonce
  869.    GOTO gcc
  870.   END IF
  871.  
  872.   ftl = array%(acx-1,acy+1)
  873.   flc = array%(acx-1,acy)
  874.   IF (ftl = 0) AND (flc = 0) THEN
  875.    array%(acx,acy)=0
  876.    array%(acx-1,acy+1)=fall
  877.    PUT (x%(acx-1),y%(acy+1)),anim%(fall,0),PSET
  878.    PUT (x%(acx),y%(acy)),anim%(0,0),PSET
  879.    hb=array%(acx-1,acy+2)
  880.    IF hb=15 THEN GOSUB bonce
  881.    GOTO gcc
  882.   END IF
  883.  
  884.   ftr = array%(acx+1,acy+1)
  885.   frc = array%(acx+1,acy)
  886.   IF (ftr = 0) AND (frc = 0) THEN
  887.    array%(acx,acy)=0
  888.    array%(acx+1,acy+1)=fall
  889.    PUT (x%(acx+1),y%(acy+1)),anim%(fall,0),PSET
  890.    PUT (x%(acx),y%(acy)),anim%(0,0),PSET
  891.    hb=array%(acx+1,acy+2)
  892.    IF hb=15 THEN GOSUB bonce
  893.    GOTO gcc
  894.   END IF
  895.  
  896.   END IF
  897.   gcc:
  898.  NEXT
  899. NEXT
  900.  
  901. GOTO gmove
  902.  
  903. gho:
  904. gc = gc +1
  905. IF gc = 3 THEN  
  906.    IF y < yg THEN gd=3
  907.    IF y > yg THEN gd=1
  908. END IF
  909. IF gc = 6 THEN
  910.    IF x < xg THEN gd=2
  911.    IF x > xg THEN gd=0
  912.    gc=0
  913. END IF
  914.       IF gd =0 THEN xg=xg +1
  915.       IF gd =1 THEN yg=yg +1
  916.       IF gd =2 THEN xg=xg -1
  917.       IF gd =3 THEN yg=yg -1   
  918. gob=array%(xg,yg) 
  919.  
  920. IF (gob =9) OR ((gob=15) AND (w=-1) AND (ibx>0)) THEN 
  921.    gst =0
  922.    PUT (x%(xg),y%(yg)),anim%(14,0),PSET
  923.    
  924.    array%(xg,yg)=14
  925.    gbc =array%(xg1,yg1)
  926.    if (gbc=16) then 
  927.      PUT (x%(xg1),y%(yg1)),anim%(0,0),PSET
  928.      array%(xg1,yg1)=0
  929.    END IF
  930.    xg1=xg:yg1=yg
  931.    FOR s = 1 TO 5
  932.     SOUND s*100,1,255,0
  933.     NEXT
  934.    RETURN
  935. END IF
  936.     IF (gob =4) OR (gob =7) OR (gob =6) THEN 
  937.       xg=xg1:yg=yg1 
  938.       gd=INT(RND*4)
  939.     END IF   
  940.  gdl=gdl-1
  941.     IF gdl =0 THEN
  942.       gd=INT(RND*4)
  943.       gdl=INT(RND*7)+10
  944.     END IF
  945. cz=0
  946. IF xg<>xg1 THEN cz=cz+1
  947. IF yg<>yg1 THEN cz=cz+1    
  948. PUT (x%(xg),y%(yg)),anim%(f+2,0),PSET 
  949. array%(xg,yg)=16
  950. IF cz >0 THEN
  951. if array%(xg1,yg1)=16 then
  952. PUT (x%(xg1),y%(yg1)),anim%(0,0),PSET     
  953. array%(xg1,yg1)=0
  954. end if
  955. END IF
  956. IF gob =2 THEN dime =dime -1
  957. xg1=xg:yg1=yg
  958. RETURN      
  959.  
  960. sob:
  961. IF (gx = x1) AND (gy = y1) THEN RETURN
  962. IF (gx = xg1) AND (gy = yg1) THEN RETURN
  963.  
  964. IF gst =0 THEN
  965. sn = sn +1
  966. IF sn <10 THEN GOTO sob2
  967. sn = 0
  968. xg=gx:yg=gy:xg1=xg:yg1=yg
  969. gst = 1
  970. RETURN 
  971. END IF
  972.  
  973. sob2:
  974. s%=INT(RND*5)+1            
  975. IF (s% =4) OR (s% =2) OR (s% =3) THEN RETURN
  976. sound 600,1,vol,0          
  977. array%(gx,gy)=s%
  978. PUT (x%(gx),y%(gy)),anim%(s%,0),PSET 
  979. RETURN
  980.  
  981. minus:
  982.  kgot = kgot-1
  983.   IF kgot <0 THEN kgot =0
  984.   PUT (x%(kp+kgot+1),0),anim%(0,0),PSET
  985. e=e+8
  986. SOUND 131,1,255,0
  987. SOUND 147,1,255,1
  988. GOSUB energy
  989. RETURN
  990.  
  991. bonce:
  992. IF cq <> 0 THEN RETURN
  993. GOSUB effectl
  994. e=186
  995. GOSUB energy
  996. RETURN
  997.  
  998. plus:
  999. score = score + 10
  1000. e=e-4
  1001. SOUND 392,1,vol,0
  1002. GOSUB energy
  1003. RETURN
  1004.  
  1005. trow:
  1006. FOR bl = 0 TO 17
  1007.  PUT (x%(bl),0),anim%(0,0),PSET
  1008. NEXT
  1009. RETURN
  1010.  
  1011. lives:
  1012. FOR li = 0 TO 3
  1013.  PUT (x%(li),0),anim%(0,0),PSET
  1014. NEXT
  1015.  
  1016. IF life<1 THEN RETURN 
  1017. FOR li = 0 TO life-1
  1018.  PUT (x%(li),0),anim%(8,0),PSET
  1019. NEXT
  1020. RETURN
  1021.  
  1022. ice:
  1023. FOR ki = 4 TO 4+ibx
  1024.  PUT (x%(ki),0),anim%(9,0),PSET
  1025. NEXT
  1026. RETURN
  1027.  
  1028. keys:
  1029. IF kgot <1 THEN RETURN
  1030. kn = kp+1
  1031. FOR ky = kn TO kn+kgot-1
  1032.  PUT (x%(ky),0),anim%(3,0),PSET
  1033. NEXT
  1034. RETURN
  1035.  
  1036.  
  1037. iceg:
  1038. ibx = ibx +1
  1039. IF ibx >8 THEN ibx =8 :RETURN
  1040. FOR ic = ip TO ip+ibx-1
  1041.  PUT (x%(ic),0),anim%(9,0),PSET
  1042. NEXT
  1043. SOUND 220,1,vol,0
  1044. FOR d = 1 TO 1000:NEXT
  1045. array%(x,y)=0
  1046. RETURN
  1047.  
  1048. icel:
  1049. ibx = ibx -1
  1050. IF ibx <0 THEN ibx =0 :RETURN
  1051. FOR ic = ip+ibx TO ip+ibx+1
  1052.  PUT (x%(ic),0),anim%(0,0),PSET
  1053. NEXT
  1054. SOUND 440,1,vol,0
  1055. FOR d = 1 TO 1000:NEXT
  1056. bori=9
  1057. RETURN
  1058.  
  1059. energy:
  1060. IF e < 0 THEN
  1061.    IF life =3 THEN                             
  1062.       score = score + 10
  1063.       e=0
  1064.    END IF
  1065.    
  1066.    IF life <3 THEN
  1067.       GOSUB effectg
  1068.       life = life +1
  1069.       GOSUB lives
  1070.       e = 90
  1071.    END IF
  1072. END IF
  1073.  
  1074. IF e > 185 THEN 
  1075.    GOSUB effectl
  1076.    life = life -1
  1077.    GOSUB lives
  1078.    e = 90
  1079. END IF
  1080.  
  1081. LINE (307,0)-(314,e),0,bf
  1082. LINE (307,185)-(314,e),2,bf
  1083. RETURN
  1084.  
  1085. effectg:
  1086. for d = 1 to 10
  1087. SOUND 200*d,1,255,0
  1088. PALETTE 2,RND,RND,RND
  1089. gosub holdit
  1090. next
  1091. PALETTE 2,0,1,0       :REM green
  1092. RETURN
  1093.  
  1094. effectl:
  1095. FOR d = 1 TO 10
  1096.  SOUND 2000/d,1,255,0
  1097.  PALETTE 2,RND,RND,RND
  1098.  GOSUB holdit
  1099. NEXT
  1100. PALETTE 2,0,1,0       :REM green
  1101. RETURN
  1102.  
  1103. holdit:
  1104. FOR i = 1 TO 2000
  1105. NEXT
  1106. RETURN
  1107.  
  1108. Over:
  1109. CLS
  1110. GOSUB ok
  1111. IF score > hiscore THEN hiscore = score
  1112. n$="t1":GOSUB fetch
  1113. LOCATE 7,9
  1114. PRINT "GAME OVER" 
  1115. LOCATE 9,9
  1116. PRINT "Screen ";CHR$(scrn + 64)
  1117. LOCATE 11,9
  1118. PRINT "Score";score
  1119. LOCATE 13,9
  1120. PRINT "Hi Score";hiscore
  1121. LOCATE 15,9
  1122. PRINT "Press a Key"
  1123. GOSUB ok
  1124. oloop:
  1125. a$=INKEY$
  1126. IF a$ = "" THEN GOTO oloop
  1127. GOTO options
  1128.  
  1129. pause:
  1130. FOR del = 1 TO 100:PALETTE 1,.7,RND,0:NEXT
  1131. a$=INKEY$
  1132. PALETTE 1,.7,RND,0
  1133. w=STRIG(3)
  1134. IF w <0 THEN GOTO x
  1135. IF a$ = "" THEN GOTO pause
  1136. x:
  1137. PALETTE 1,1,.5,0    :REM brown
  1138. RETURN
  1139.  
  1140. nopoint:
  1141. FOR pc = 20212 TO 20275
  1142.  POKE pc,0
  1143. NEXT
  1144. RETURN
  1145.  
  1146. apoint:
  1147. RESTORE frog
  1148. FOR pc = 0 TO 63
  1149.  READ da 
  1150.  POKE 20212+pc,da
  1151. NEXT
  1152. RETURN
  1153. frog:
  1154. DATA 0,0,60,60,60,60,66,66,78,78 
  1155. DATA 185,185,78,78,189,189,126,126,189,189 
  1156. DATA 126,126,153,153,61,188,66,66,3,192 
  1157. DATA 60,60,15,240,16,8,29,184,34,68 
  1158. DATA 23,232,40,20,24,24,39,228,44,52 
  1159. DATA 83,202,119,238,136,17,115,206,140,49 
  1160. DATA 0,0,255,255 
  1161.  
  1162. tpoint:
  1163. RESTORE tofrog
  1164. FOR pc = 0 TO 31
  1165.  READ da 
  1166.  POKE 20244+pc,da
  1167. NEXT
  1168. RETURN
  1169. tofrog: 
  1170. DATA 0,0,255,255,127,254,255,255
  1171. DATA 64,134,255,255,115,50,255,255,115,50 
  1172. DATA 255,255,115,134,255,255,127,254,255,255 
  1173. DATA 0,0,255,255 
  1174. END
  1175.